home *** CD-ROM | disk | FTP | other *** search
/ The Original Shareware 1.1 / The Original Shareware (WeMake CDs)(Volume 1.1)(CDs, Inc)(1993).iso / 32 / kaledis.zip / KALEDIS.PAS < prev   
Pascal/Delphi Source File  |  1986-06-07  |  3KB  |  105 lines
  1. PROGRAM KALEDIS;
  2.  
  3. CONST
  4.     CX = 320;
  5.     CY = 175;
  6.     M = 175;
  7.     ESC = #27; { escape }
  8.  
  9. VAR
  10.     X1, Y1, X2, Y2, XV1, YV1, XV2, YV2, HC: INTEGER;
  11.     XA, YA, XB, YB: INTEGER;
  12.     CH: CHAR;
  13.  
  14. {$I EGA\GPPARMS.P }
  15. {$I EGA\GPINIT.P  }
  16. {$I EGA\GPTERM.P  }
  17. {$I EGA\GPCOLOR.P }
  18. {$I EGA\GPMOVE.P  }
  19. {$I EGA\GPLINE.P  }
  20.  
  21.  
  22. BEGIN
  23.   CLRSCR;
  24.   TEXTCOLOR(WHITE);
  25.   GOTOXY(27,06); WRITE('K A L E D I S C O P E');
  26.   GOTOXY(27,08); WRITE('for EGA with 128K/256K');
  27.   GOTOXY(28,10); WRITE('Judson D. McClendon');
  28.   GOTOXY(28,11); WRITE('844 Sun Valley Road');
  29.   GOTOXY(28,12); WRITE('Birmingham, AL 35215');
  30.   GOTOXY(32,13); WRITE('[74415,1003]');
  31.  
  32.   GPPARMS;
  33.   IF GDTYPE <> 5 THEN
  34.     BEGIN
  35.       CLRSCR;
  36.       GOTOXY(28,15); WRITE('Enhanced Graphic Adaptor not found');
  37.       HALT(1);
  38.     END;
  39.   IF GDMEMORY < 128 THEN
  40.     BEGIN
  41.       CLRSCR;
  42.       GOTOXY(28,15); WRITE('Must have 128K or more EGA memory');
  43.       HALT(1)
  44.     END;
  45.  
  46.   GOTOXY(27,15); WRITE ('Press "P" to pause,');
  47.   GOTOXY(27,16); WRITE ('Press ESCape to exit,');
  48.   GOTOXY(27,17); WRITE ('Press any key to begin/resume: ');
  49.  
  50.   READ (KBD,CH);
  51.   IF CH = ESC THEN
  52.     HALT;
  53.  
  54.   RANDOMIZE;
  55.  
  56.   WHILE TRUE DO
  57.     BEGIN
  58.       GPINIT;
  59.       X1 := RANDOM(M);
  60.       X2 := RANDOM(M);
  61.       Y1 := RANDOM(X1+1);
  62.       Y2 := RANDOM(X2+1);
  63.       WHILE RANDOM > 0.01 DO
  64.         BEGIN
  65.           XV1 := RANDOM(11) - 5;
  66.           XV2 := RANDOM(11) - 5;
  67.           YV1 := RANDOM(11) - 5;
  68.           YV2 := RANDOM(11) - 5;
  69.           HC := RANDOM(1276) MOD 16;
  70.           GPCOLOR(HC);
  71.           WHILE RANDOM > 0.1 DO
  72.             BEGIN
  73.               XA := X1*9 DIV 5;
  74.               XB := X2*9 DIV 5;
  75.               YA := Y1*9 DIV 5;
  76.               YB := Y2*9 DIV 5;
  77.               GPMOVE( (CX+XA), (CY-Y1) ); GPLINE( (CX+XB), (CY-Y2) );
  78.               GPMOVE( (CX-YA), (CY+X1) ); GPLINE( (CX-YB), (CY+X2) );
  79.               GPMOVE( (CX-XA), (CY-Y1) ); GPLINE( (CX-XB), (CY-Y2) );
  80.               GPMOVE( (CX-YA), (CY-X1) ); GPLINE( (CX-YB), (CY-X2) );
  81.               GPMOVE( (CX-XA), (CY+Y1) ); GPLINE( (CX-XB), (CY+Y2) );
  82.               GPMOVE( (CX+YA), (CY-X1) ); GPLINE( (CX+YB), (CY-X2) );
  83.               GPMOVE( (CX+XA), (CY+Y1) ); GPLINE( (CX+XB), (CY+Y2) );
  84.               GPMOVE( (CX+YA), (CY+X1) ); GPLINE( (CX+YB), (CY+X2) );
  85.               X1 := (X1 + XV1) MOD M;
  86.               Y1 := (Y1 + YV1) MOD M;
  87.               X2 := (X2 + XV2) MOD M;
  88.               Y2 := (Y2 + YV2) MOD M;
  89.             END;
  90.           IF KEYPRESSED THEN
  91.             BEGIN
  92.             READ(KBD,CH);
  93.             IF UPCASE(CH) = 'P' THEN
  94.               READ(KBD,CH);
  95.             IF CH = ESC THEN
  96.               BEGIN
  97.               GPTERM;
  98.               HALT;
  99.               END;
  100.             END;
  101.         END;
  102.     END;
  103.   GPTERM;
  104. END.
  105.